home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / JTools / Demos / demo_sprite < prev    next >
Encoding:
Text File  |  1991-12-30  |  5.4 KB  |  198 lines
  1. \ Demonstrate simple sprite control.
  2. \ Move a HARDWARE sprite about in a custom screen.
  3. \ Leave a trail of color to mark it's path.
  4. \ DS-XMIN and DS-YMAX can be changed to generate different patterns.
  5. \
  6. \ Author:  Phil Burk
  7. \ Copyright 1986 Delta Research
  8.  
  9. decimal
  10. INCLUDE? NewWindow.Setup JU:AMIGA_GRAPH
  11. INCLUDE? ?CLOSEBOX JU:AMIGA_EVENTS
  12. INCLUDE? NewScreen.Setup JU:SCREEN_SUPPORT
  13. INCLUDE? SPRITES JI:GRAPHICS/VIEW.j
  14. INCLUDE? SimpleSprite JI:GRAPHICS/SPRITE.J
  15. INCLUDE? GETSPRITE() JU:SPRITES
  16. INCLUDE? { JU:LOCALS
  17.  
  18. ANEW TASK-DEMO_SPRITE
  19.  
  20. decimal
  21.  
  22. \ Declare necessary Amiga 'C' structures.
  23. NewScreen SpriteNewScreen
  24. NewWindow SpriteNewWindow
  25. SimpleSprite Sprite-1
  26.  
  27. VARIABLE SPRITE-SCREEN
  28.  
  29. : CLOSE.SPRITE.SCREEN ( -- , CLose demo screen )
  30.     sprite-screen @ closescreen()
  31. ;
  32.  
  33. : OPEN.SPRITE.SCREEN ( -- screen | NULL )
  34. \ Set to default values.
  35.     SpriteNewScreen NewScreen.Setup
  36.     SpriteNewWindow NewWindow.Setup
  37. \
  38. \ Modify defaults for this demo.
  39. \ Allow SPRITEs for this screen.
  40.     SPRITES SpriteNewScreen ..! ns_viewmodes
  41.     4 SpriteNewScreen ..! ns_depth  ( 16 colors )
  42.     0" Sprite - JForth - Delta Research" >abs
  43.         SpriteNewScreen ..! ns_DefaultTitle
  44. \
  45. \ Open Screen and store pointer in NewWindow structure.
  46.     SpriteNewScreen openscreen() dup Sprite-Screen !  ( Open screen. )
  47. \
  48. \ Sometimes the Amiga can build a bad COPPER list for screens.
  49. \ This can happen if you have Emacs and Workbench up in INTERLACE
  50. \ mode and open a NON-INTERLACE screen.
  51. \ The following calls will correct this problem (hopefully).
  52.     dup
  53.     IF  sprite-screen @ screentoback()
  54.         RemakeDisplay()
  55.         sprite-screen @ screentofront()
  56.     THEN
  57. ;
  58.  
  59. \ Check for proper opening.
  60. : OPEN.SPRITE.WINDOW  ( screen -- window | NULL )
  61.     >abs SpriteNewWindow ..! nw_screen
  62. \
  63. \ Set up window.
  64.     CUSTOMSCREEN   SpriteNewWindow ..! nw_type
  65.     0    SpriteNewWindow ..! nw_TopEdge
  66.     320  SpriteNewWindow ..! nw_Width
  67.     200  SpriteNewWindow ..! nw_Height
  68.     SpriteNewWindow gr.opencurw
  69. ;
  70.  
  71. : OPEN.SPRITE ( -- sprite# )
  72.     sprite-1 -1 GetSprite() dup -1 =
  73.     abort" OPEN.SPRITE - Sprite could not be allocated!"
  74.     0 sprite-1 ..! ss_x
  75.     0 sprite-1 ..! ss_y
  76.     12 sprite-1 ..! ss_height
  77. ;
  78.  
  79. \ Build sprite data, sprites are two planes deep.
  80. 2 base !   ( Use binary to see which bits are on. )
  81. CREATE SPRITE-DATA
  82. here
  83.     0 w,    0 w,   ( position control, used by system. )
  84. \        Plane0                    Plane1
  85.     0000,0011,1100,0000 W,    0000,0000,0000,0000 W,
  86.     0000,1101,1011,0000 W,    0000,0001,1000,0000 W,
  87.     0001,0001,1000,1000 W,    0000,0001,1000,0000 W,
  88.     0010,0001,1000,0100 W,    0000,0001,1000,0000 W,
  89.     0100,0001,1000,0010 W,    0000,0001,1000,0000 W,
  90.     1000,0001,1000,0001 W,    0000,0001,1000,0000 W,
  91.     1000,0001,1000,0001 W,    0000,0011,1100,0000 W,
  92.     0100,0001,1000,0010 W,    0000,1101,1011,0000 W,
  93.     0010,0001,1000,0100 W,    0001,1001,1001,1000 W,
  94.     0001,0001,1000,1000 W,    0000,0001,1000,0000 W,
  95.     0000,1101,1011,0000 W,    0000,0001,1000,0000 W,
  96.     0000,0011,1100,0000 W,    0000,0000,0000,0000 W,
  97.         0 W,     0 W,   ( unattached simple sprite. )
  98.  
  99. here swap - constant SPRITE_DATA_SIZE
  100. decimal
  101.  
  102. VARIABLE SPRITE-DATA-PTR  ( point to ALLOCed CHIP RAM copy )
  103. : CHANGE.SPRITE
  104. \ Allocate CHIP memory and copy sprite to it.
  105. \ AMIGAs with more than 512K RAM might be running
  106. \ JForth in FAST RAM.  We could NOT, therefore, use
  107. \ the SPRITE-DATA directly since it would be inaccessable
  108. \ to the graphics coprocessors.
  109.     MEMF_CHIP sprite_data_size allocblock ?dup
  110.     IF dup sprite-data-ptr !   ( save memory pointer )
  111.         sprite-data swap sprite_data_size cmove ( copy )
  112.     THEN
  113.     0 sprite-1 sprite-data-ptr @ ChangeSprite()
  114. ;
  115.  
  116. VARIABLE SPRITE-NUM
  117.  
  118. : FREE.SPRITE
  119.     sprite-num @ freesprite()
  120.     sprite-data-ptr @ freeblock
  121. ;
  122.  
  123. \ Sprite MOTION control ------------------------------------
  124. \ Slowly cycle through the 16 colors, using a diferent set of 5,
  125. \ every 71 passes.
  126. VARIABLE DS-COLOFF  ( Color offset )
  127. VARIABLE DS-COUNT   ( Count of bounces. )
  128. VARIABLE DS-CYCLEN
  129. VARIABLE DS-#COLORS
  130. 71 ds-cyclen !
  131. 4 ds-#colors !
  132. : DS.NEXT.COLOR  ( -- )
  133.     gr.color@ ds-coloff @ -
  134.     ds-#colors @ mod 1+
  135.     ds-coloff @ + gr.color!   ( advance color )
  136.     ds-count @ 1+ dup ds-count ! ( count bounces )
  137.     ds-cyclen @ >
  138.     IF  ds-coloff @ 1+
  139.         16 ds-#colors @ - mod  ds-coloff ! ( move to next group )
  140.         0 ds-count !
  141.     THEN
  142. ;
  143.  
  144. \ Use local variables to enhance readability.
  145. \ The first two parameters are addresses so you need to use @ and !
  146. : BOUNCE.OFF { bo-apos bo-avel bo-min bo-max -- , bounce thing }
  147.     bo-apos @ bo-avel @ +
  148.     dup bo-min bo-max within?
  149.     IF bo-apos !    ( update position )
  150.     ELSE drop bo-avel @ negate bo-avel !  ( bounce )
  151. \ Special color control for this demo, optional.
  152.         ds.next.color
  153.     THEN
  154. ;
  155.  
  156. \ Sprite position and velocity control.
  157. VARIABLE DS-XPOS
  158. VARIABLE DS-YPOS
  159. VARIABLE DS-XVEL
  160. VARIABLE DS-YVEL
  161. VARIABLE DS-XMAX
  162. VARIABLE DS-YMAX
  163. \ Initial values.
  164. 5 ds-xpos ! 5 ds-ypos !
  165. 1 ds-xvel ! 1 ds-yvel !
  166. 290 ds-xmax !  181 ds-ymax !
  167.  
  168. : MOVE.SPRITE ( -- , Move sprite around screen )
  169.     2 gr.color!
  170.     ds-xpos @ 5 + ds-ypos @ 5 - gr.move
  171.     BEGIN
  172.         ds-xpos ds-xvel 0 ds-xmax @ bounce.off
  173.         ds-ypos ds-yvel 0 ds-ymax @ bounce.off
  174.         0 sprite-1  ds-xpos @ ds-ypos @  movesprite()
  175.         ds-xpos @ 5 + ds-ypos @ 5 - gr.draw ( leave trail )
  176.         ?CLOSEBOX
  177.     UNTIL
  178. ;
  179.  
  180. : GO.SPRITE  ( -- Run Sprite demo. )
  181.     ." GO.Sprite - JForth - Delta Research" cr
  182.     gr.init
  183.     open.sprite.screen ?dup
  184.     IF  open.sprite.window
  185.         IF  open.sprite sprite-num !
  186.             change.sprite
  187.             move.sprite
  188.             free.sprite
  189.             gr.closecurw
  190.         THEN
  191.         close.sprite.screen
  192.     ELSE ." Could not open screen!" cr
  193.     THEN
  194.     gr.term
  195. ;
  196.  
  197. ." Enter:    GO.Sprite   for demo." cr
  198.